home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / examples / hanoi / hanoi.ml next >
Encoding:
Text File  |  1995-06-01  |  3.1 KB  |  75 lines  |  [TEXT/MPS ]
  1. let blancs n = make_string n ` `;;
  2. let disque taille =
  3.     let moitié_droite = make_string taille `>`
  4.     and moitié_gauche = make_string taille `<`
  5.     in moitié_gauche ^ "|" ^ moitié_droite;;
  6. let disque_numéro n taille_grand_disque =
  7.     let partie_blanche = blancs (taille_grand_disque + 1 - n) in
  8.     partie_blanche ^ (disque n) ^ partie_blanche;;
  9. let base_de_tige taille_grand_disque =
  10.     let moitié = make_string taille_grand_disque `_` in
  11.     " " ^ moitié ^ "|" ^ moitié ^ " ";;
  12. let rec tige taille_grand_disque = function
  13.     (0, []) -> []
  14.   | (0, tête::reste) ->
  15.       disque_numéro tête taille_grand_disque ::
  16.       tige taille_grand_disque (0, reste)
  17.   | (décalage, liste) ->
  18.       disque_numéro 0 taille_grand_disque ::
  19.       tige taille_grand_disque (décalage-1, liste);;
  20. let rec recolle l1 l2 l3 =
  21.   match (l1, l2, l3) with
  22.     ([], [], []) -> []
  23.   | (t1::r1, t2::r2, t3::r3) -> (t1 ^ t2 ^ t3) :: recolle r1 r2 r3
  24.   | _ -> failwith "recolle";;
  25. let imprime ligne = print_string ligne; print_newline();;
  26. let imprime_jeu nombre_de_disques départ milieu arrivée =
  27.     let dessin =
  28.         recolle (tige nombre_de_disques départ)
  29.                 (tige nombre_de_disques milieu)
  30.                 (tige nombre_de_disques arrivée) in
  31.     do_list imprime dessin;
  32.     let b = base_de_tige nombre_de_disques in imprime (b ^ b ^ b);;
  33. let ajoute_disque disque (décalage, disques as tige) =
  34.     (décalage - 1, disque::disques);;
  35. let sommet = function
  36.     (décalage, sommet :: reste) -> sommet
  37.   | (décalage, []) -> failwith "sommet: tige vide";;
  38. let enlève_sommet = function
  39.     (décalage, sommet :: reste) -> (décalage + 1, reste)
  40.   | (décalage, []) -> failwith "enlève_sommet: tige vide";;
  41. let déplace (nom_départ, tige_départ) (nom_arrivée, tige_arrivée) =
  42.     imprime("Je déplace un disque de " ^
  43.             nom_départ ^ " à " ^ nom_arrivée);
  44.     let disque_déplacé = sommet !tige_départ in
  45.     tige_départ := enlève_sommet !tige_départ;
  46.     tige_arrivée := ajoute_disque disque_déplacé !tige_arrivée;;
  47. let tige_vide nombre_de_disques = (nombre_de_disques, []);;
  48. let tige_pleine nombre_de_disques =
  49.     let rec liste_des_disques i =
  50.         if i <= nombre_de_disques
  51.         then i :: liste_des_disques (i+1)
  52.         else [] in
  53.     (0, liste_des_disques 1);;
  54. let jeu nombre_de_disques =
  55.     let gauche = ref (tige_pleine nombre_de_disques)
  56.     and milieu = ref (tige_vide nombre_de_disques)
  57.     and droite = ref (tige_vide nombre_de_disques) in
  58.     let rec hanoi hauteur départ intermédiaire destination =
  59.         if hauteur > 0 then
  60.          begin
  61.            hanoi (hauteur - 1) départ destination intermédiaire;
  62.            déplace départ destination;
  63.            imprime_jeu nombre_de_disques !gauche !milieu !droite;
  64.            hanoi (hauteur - 1) intermédiaire départ destination
  65.          end in
  66.     imprime "J'appelle les tiges A, B et C.";
  67.     imprime "Position de départ:";
  68.     imprime_jeu nombre_de_disques !gauche !milieu !droite;
  69.     hanoi nombre_de_disques
  70.           ("A", gauche) ("B", milieu) ("C", droite);;
  71. if sys__interactive then () else begin
  72.   jeu (int_of_string (sys__command_line.(1)));
  73.   exit 0
  74. end;;
  75.